Ham Radio 2000/Ham Radio 2000.iso/ham2000/packet/terminal/top_152/src152.exe/rar/TOP7PL.PAS

Pascal/Delphi Source File | 1995-05-16 | 5KB | 171 lines

{┌─────────────────────────────────────────────────────────────────────────┐}
{│                                                                         │}
{│                              T. O. P.                                   │}
{│                                                                         │}
{│                        (T)he  (O)ther  (P)acket                         │}
{│                                                                         │}
{│ T O P 7 P L . P A S                                                     │}
{│                                                                         │}
{│                                                                         │}
{│ Routinen fuer den Empfang von 7Plusfiles                                │}
{└─────────────────────────────────────────────────────────────────────────┘}


Procedure Open_Close_7Plus (* Kanal : Byte; Zeile : Str80 *);
Const   Cnt    = 'CNT';
Var     i,i1   : Byte;
        Result : Word;
        Sstr   : String[8];
        Nstr   : String[12];
        Vstr   : String[80];
        Suf    : String[3];
        Flag   : Boolean;
        f      : Text;
Begin
  with K[Kanal]^ do
  begin
    if SplSave then
    begin
      Vstr := FName_aus_FVar(SplFile);
      SplSave := false;
      Spl_COR_ERR := false;
      FiResult := CloseBin(SplFile);
      Umlaut := Spl_UmlMerk;
      if Klingel and BLTON then Beep(800,100);

      Vstr := copy(Vstr,1,pos(Pkt,Vstr)) + Cnt;
      Assign(f,Vstr);
      if RewriteTxt(f) = 0 then
      begin
        Writeln(f,Spl_gCount);
        FiResult := CloseTxt(f);
      end;
    end else
    begin
      if MldOk = 11 then   (* 7PL .. P0X *)
      begin
        Spl_Time := Uhrzeit;
        Spl_tCount := 0;
        Spl_tLaenge := str_int('$' + ParmStr(7,B1,Zeile));
        Spl_tLaenge := (Spl_tLaenge div 64) +  2;

        i1 := str_int(ParmStr(4,B1,Zeile));
        Spl_gLaenge := str_int(ParmStr(6,B1,Zeile));
        Spl_gLaenge := (Spl_gLaenge div 62) +  2 * i1;
        if Spl_gLaenge mod 62 > 0 then inc(Spl_gLaenge);
        Spl_gLaenge := Spl_gLaenge * 69;
        Spl_tLaenge := Spl_tLaenge * 69;

        Nstr := copy(Zeile,20,8);

        While pos(BS,Nstr) > 0 do delete(Nstr,1,pos(BS,Nstr));
        While pos(Sst,Nstr) > 0 do delete(Nstr,1,pos(Sst,Nstr));
        While pos(DP,Nstr) > 0 do delete(Nstr,1,pos(DP,Nstr));
        While pos(Pkt,Nstr) = 1 do delete(Nstr,1,1);

        i := pos(Pkt,Nstr);
        if i > 0 then Nstr := copy(Nstr,1,i-1);
        KillEndBlanks(Nstr);
        if Nstr = '' then
        begin
          Nstr := Call;
          Strip(Nstr);
        end;
        if i1 = 1 then Suf := '7PL'
                  else Suf := 'P' + Hex(str_int(ParmStr(2,B1,Zeile)),2);
        Nstr := Nstr + Pkt + Suf;
      end;

      if MldOk = 14 then   (* COR und ERR-File *)
      begin
        Spl_COR_ERR := true;
        Nstr := ParmStr(2,B1,Zeile);

        While pos(BS,Nstr) > 0 do delete(Nstr,1,pos(BS,Nstr));
        While pos(Sst,Nstr) > 0 do delete(Nstr,1,pos(Sst,Nstr));
        While pos(DP,Nstr) > 0 do delete(Nstr,1,pos(DP,Nstr));
        While pos(Pkt,Nstr) = 1 do delete(Nstr,1,1);

        i := 0;
        While Exists(G^.SPlusPfad + copy(Nstr,1,pos(Pkt,Nstr)-1) + BS + Nstr) do
        begin
          inc(i);
          delete(Nstr,length(Nstr)-1,2);
          Nstr := Nstr + SFillStr(2,'0',Hex(i,2));
        end;
      end;

      Vstr := copy(Nstr,1,pos(Pkt,Nstr)-1);

      if MkSub(G^.SPlusPfad + Vstr) then
      begin
        if not Exists(G^.SPlusPfad + Vstr + BS  + Nstr) then
        begin
          Vstr := G^.SPlusPfad + Vstr + BS  + Nstr;
          Assign(SplFile,Vstr);
          Result := RewriteBin(SplFile,T);
        end else
        begin
          i := 0;
          Repeat
            inc(i);
            Sstr := Call;
            Strip(Sstr);
            Sstr := int_str(i) + Sstr;
            Flag := not Exists(G^.SPlusPfad + Vstr + BS  + Sstr + BS  + Nstr);
          Until Flag or (i > 250);
          if Flag then
          begin
            if MkSub(G^.SPlusPfad + Vstr + BS  + Sstr) then
            begin
              Vstr := G^.SPlusPfad + Vstr + BS  + Sstr + BS  + Nstr;
              Assign(SplFile,Vstr);
              Result := RewriteBin(SplFile,T);
            end else Result := 1;
          end else Result := 1;
        end;

        if Result = 0 then
        begin
          SplSave := true;
          Spl_UmlMerk := Umlaut;
          Umlaut := 0;
          if Klingel and BLTON then Beep(1500,100);

          Vstr := copy(Vstr,1,pos(Pkt,Vstr)) + Cnt;
          Assign(f,Vstr);
          if ResetTxt(f) = 0 then
          begin
            Readln(f,Spl_gCount);
            FiResult := CloseTxt(f);
          end else Spl_gCount := 0;
        end else
        begin
          Triller;
          MldOk := 0;
        end;
      end else
      begin
        Triller;
        MldOk := 0;
      end;
    end;
    SetzeFlags(Kanal);
  end;
End;


Procedure Close_7Plus (* Kanal : Byte *);
Begin
  with K[Kanal]^ do
  begin
    if SplSave then
    begin
      SplSave := false;
      Spl_COR_ERR := false;
      FiResult := CloseBin(SplFile);
      Umlaut := Spl_UmlMerk;
    end;
  end;
End;